perm filename INGWAY.MAC[IP,SYS] blob sn#680209 filedate 1982-10-14 generic text, type T, neo UTF8
;CWL:<403-INET>INGWAY.MAC.40303 10-May-82 12:22:49, Edit by CLYNN
; Add IP Option support
;<TAPPAN.4>INGWAY.MAC.4, 18-Feb-82 13:16:00, Edit by TAPPAN
; Converted to use Multinet (under MNET conditionals) 
; Use new (extended network number) method for looking up
; gateways and interfaces
;<403-INET>INGWAY.MAC.40301 29-Jan-82 15:12:19, Edit by CLYNN
; Updated for IP release 3
; Move parameters & variables to STG; New PITOS field & mappings
; Add: IP fragmentation and reassembly & pick prime gwy for unknown nets
;[BBNF]<402-INET>INGWAY.MAC.80, 13-Jul-81 11:05:00, Ed: CLYNN
; Fix: HTY%HP in SNDAR2
;<402-INET>INGWAY.MAC.78, 23-Mar-81 16:46:43, Edit by TAPPAN
; Add minimal source routing (used only from user q's)

	SEARCH	INPAR,TCPPAR,IMPPAR,PROLOG
IFN MNET,<SEARCH MNTPAR>

	TTITLE	INGWAY
	SUBTTL	Internet Gateway, William W. Plummer, 28Feb79
	SWAPCD
COMMENT	!

These routines link all Internet protocol modules with interface
drivers such as IMPDV and IMPPHY.  This is a "full gateway".  All
interfaces (ie, network inputs), queue messages on INTIBx.  When
RCVGAT is called it looks to see if the input message is addressed
to this host, and if so, returns it to the gateway for processing.
If not, it calls SNDGAT to get the message forwarded to the
appropriate host or gateway.

It may be that the gateway function is imlemented in a box connected
to this machine using a BBN 1822 interface.  If so, packets with no
local headers will be sent over the RPI (Raw Packet Interface) if
INTSCR is non-0.  If this device is present and being used, packets
cannot be forwarded in RCVGAT

* GATINI ...  3 ...... Initialize the gateway

* SNDGAT ...  4 ...... Send a packet into the network
  SNDGA1 ...  6 ...... Forward received packet
  SNDPKT ...  8 ...... Send PKT to an interface driver
  SNDLCL ...  9 ...... Send a packet over internal bypas
  SNDGAB ... 11 ...... Zero flags and ...
  SNDGAC ... 11 ...... Fill in internet checksum and interrupt length

* RCVGAT ... 12 ...... Recv a packet from the network(s)

  SNDFR  ... 16 ...... Fragment a packet, if required
  RCVFR  ... 24 ...... Process a received fragment, possibly reassembling
* RCVFLS ... 25 ...... Flush fragments which have timedout
  RCVRA  ... 32 ...... Reassemble fragments into a packet

* INTLKB ... 35 ...... Lock both ends of an Internet packet
* INTULK ... 36 ...... Unlock both ends of an Internet packet

  IPOPT  ... 37 ...... Process and locate IP options
  RUTOP  ... 39 ...... Process routing options
  INSHST ... 41 ...... Insert host name in routing option
  DOTSP  ... 42 ...... Process timestamp options

+ SNDARP ... 45 ...... Send a packet into the ARPANET
+ SNDRCC ... 45 ...... Send a packet into the BBN RCC Net
             46 ...... Packet radio header
+ SNDPRN ... 47 ...... Send a packet into the Packet Radio Network
+ SNDRPI ... 48 ...... Send a packet out via the Raw Packet Interface
	!

; Initialize the gateway

GATINI::
IFE MNET,<
	MOVEI T1,NLHOST+0	; 32-bit Address of ARPANET interface
	CALL DISGE		; Wait for it to be defined

	CALL NETHSI		; Initialize net hash table 

	MOVX T1,<BYTE (4) 0 (8) 0,0,-1,0>	; Bits which may be used
	MOVEM T1,INETLB		; As logical host bits (should be parameter)
	MOVE T1,NLHOST+0	; Get the address
>
IFN MNET,<
	MOVE T1,DEFADR		; Get our default address
>
	MOVEM T1,INETID		; Set our name
	RET

; SNDGAT(PKT)		; Send a packet into the Network

; Send the packet to some host on a local net which is either
; the destination or a gateway known to be capable of getting
; the packet closer to the destination.  If INTBYP is on, and
; the packet is destined for this host, a copy will be queued
; without even using the hardware at all.

;PKT/	Packet to be sent
;User 3/ Destination address if PSROU is set in PKT
;	CALL SNDGAT
;Ret+1:	Always.  Pkt may not be sent. RX or timeout should handle this.

SNDGAT::
IFN MNET,<SAVP1>		; Save NCT register

	SETONE PLCLO,(PKT)	; Packet of local origin

	MOVX T1,PT%RGI		; Packet received at gateway
	TDNE T1,INTTRC		; Want trace?
	  CALL PRNPKI		; Yes (Note: Checksum invalid here)

; Following is no longer correct/used
	JE PSCR,(PKT),SNDGA0	; Jump if not a pkt on a secure conn.
IFE MNET,<
; Multinet currently doesn't support the RPI
	SKIPN INTSCR		; Is the raw packet interface on?
>
	  JRST [MOVX T1,<DU%PRO,,ICM%DU> ; Protocol Unreachable
		JRST SNDGA5]	; Make like interface code refused it
IFE MNET,<
	XMOVEI T2,SNDRPI	; Send to gateway in connected machine
	MOVEI T3,0		; Interface class 0
	JRST SNDGA7		; Send over the Raw packet interface
>
SNDGA0:

; Normal, non-secure packet.

	STACKL <<IPOPA,↑D8>> ; Args for option processing

SRP==0		; Pointer before our sending interface's address, or 0
SRC==1		; Route option code (LSROPT or SSROPT)
RRTP==2		; Pointer before our sending interface's address, or 0

	XMOVEI T1,IPOPA		; Option arguments
	CALL IPOPT		; Do options
	  JRST SNDGA4		; Option error


; Find where to send packet (PIDH may have been changed by routing option.
; Note that if changed, the TCP checksum is "wrong" until the the last
; gateway is reached and the original destination is restored.)

	LOAD T1,PIDH,(PKT)	; Get 32-bit internet destination


; (Obsolete) First hop routing for user datagrams

	OPSTR SKIPE,PSROU,(PKT)	; If we do routing
	  UMOVE T1,3		; Get gateway address user wanted


; PNLCL is set when a packet must be forced out to the net to the
; SOURCE.  This is typically an ECHO-REPLY made by ICMP/GGP on this
; host but faked up to make it look like it came from remote gateway
; which, because it is dumb, can only forward the packet back to us.

	OPSTR SKIPE,PNLCL,(PKT)	; Special addressing?
	  LOAD T1,PISH,(PKT)	; Entire 32-bit gateway address

; Entry for RCVGAT to forward a packet

; T1/  a 32 bit destination address for which a route must be found
; PKT/ (ext) pointer to packet
; Stack has valid IPOPA block on top

SNDGA1:
	PUSH P,T1		; In case Strict Source Route
	CALL GWYLUK		; Look up the gateway or interface (sets P1/T3)
	POP P,T2		; Original Destination w/logical host
	XOR T2,T1		; Routed First Hop
IFE MNET,<TDZ T2,INETLB>	; Forget logical host mis-match
IFN MNET,<TDZ T2,NTNLHM(P1)>	; Forget logical host mis-match
	MOVE T4,SRC+IPOPA	; Get strict/lose flag
	CAIN T4,SSROPT		; Skip if not strict route
	  JUMPN T2,SNDGA3	; Jump if strict route failure
	JUMPE T1,SNDGA2		; Found a path? No
	JRST SNDGA6		; Packet ready to go


; Here if no path to that net

SNDGA2:	MOVX T1,<DU%NET,,ICM%DU> ; Net unreachable
	JRST SNDGA5		; error exit

; Strict Source Route failure

SNDGA3:	MOVX T1,<DU%SRF,,ICM%DU>
	JRST SNDGA5

; Option problem

SNDGA4:	HRRZ T1,T2		; Error code or pointer?
	TLNN T2,<-1>		; Skip if <class,,error> code
	  MOVX T1,<PP%PTR,,ICM%PP> ; This is error for pointer in T2

; Cannot send packet, ICMP error code in T1

SNDGA5:	PUSH P,T2		; Save info and
	PUSH P,T1		; ICMP error code while
	MOVX T1,PT%KIA		; Trace packet
	TDNE T1,INTTRC		; Want trace?
	  CALL PRNPKI		; Yes
	POP P,T1		; Restore ICMP error code
	POP P,T2		; and info
	CALL ICMERR		; Report error (maybe free packet)
	RET			; Return from SNDGAT

; Here after routing and interface selection have been completed
; T1 has a destination on the selected local network (maybe w/logical host)
; If not Multinet,	T3 is an interface index
; If Multinet,		P1 is the NCT address
; May have to insert host address for routing option


SNDGA6:
IFE MNET,<PUSH P,T3		; Save register
	MOVE T3,INETID>
IFN MNET,<MOVE T3,NTLADR(P1)>	; Address from which packet is being sent

	SKIPE T4,RRTP+IPOPA	; If Record route
	  CALL INSHST		; Insert host name
	SKIPE T4,SRP+IPOPA	; If Source route
	  CALL INSHST		; Insert host name
IFE MNET,<POP P,T3>		; Restore register

..X=.				; Logically clean up here, but the
	RESTORE			; Arg block stays until RET
IFN <..X-.>,<PRINTX ? SNDGA6: Stack clobbered>
	PURGE SRP,SRC,RRTP,..X


	PUSH P,T1		; Save destination from checksum
IFE MNET,<PUSH P,T3>		; Interface also

	CALL SNDGAC		; Compute checksum

IFE MNET,<POP P,T3		; Restore interface
	MOVE T2,INTFAC(T3)	; Get (ext) interface routine adr
SNDGA7:	MOVE T3,INTSIZ(T3)>	; Get maximum size for the network
IFN MNET,<MOVE T3,NTPSIZ(P1)>	; Get maximum size for the interface

	POP P,T1		; Restore destination


; Check if packet is to this host, if so, try for bypass

	SKIPE INTBYP		; Skip over if bypassing prohibited
IFE MNET,<CAME T1,INETID>	; Is it to me?
IFN MNET,<CALL LCLHST>		; Is it one of us?
	   CAIA			; No, or may not bypass
	    CALL SNDLCL		; Yes.  Try to send locally.
	JUMPE T1,R		; Sent, Go RESTORE & return from SNDGAT

; Decide if packet is too big for selected network, if so, fragment it

	LOAD T4,PIPL,(PKT)	; Get packet length
	CAMLE T4,T3		; Check against maximum size for the interface
	 CALLRET SNDFR		; Fragment it
	CALLRET SNDPKT		; Send the whole packet

; Send a packet

;T1/	Local net (first hop) destination address
;T2/	Routine (If not Multinet)
;P1/	NCT (If Multinet)
;PKT/	Packet address
;	CALL SNDPKT
;Ret+1:	Always, packet either passed to net or
;			released if error (and PINTL+PPROG=0)


SNDPKT:	PUSH P,T1		; Save the host
	PUSH P,T2		; Save the routine

	XMOVEI T2,LCLPKT(PKT)	; Pointer to interrupt level part
IFN MNET,<MOVEM T2,(P)>		; Save ptr for NTSNDI from PRNPKT
	CALL INTLKB		; Lock down the packet
	SETONE PINTL,(PKT)	; Say it has been given to int. level

	MOVX T1,PT%QLN		; Queued for local net
	TDNE T1,INTTRC		; Want trace?
	  CALL PRNPKI		; Yes

	POP P,T2		; Restore the routine/local pkt ptr
	POP P,T1		; Restore the host
IFE MNET,<
	CALL 0(T2)		; Call interface driver
	JUMPN T1,SNDPKX		; Lower level code will return storage
>
IFN MNET,<
; T1 has local net address
; T2 points to the local packet
	CALL NTSNDI		; Send an internet packet
	 CAIA			; Failed
	  JRST SNDPKX		; Success
>
	PUSH P,T1		; T1 has ICMP reason for failure
	XMOVEI T1,LCLPKT(PKT)	; Pointer to IMPDV portion
	CALL INTULK		; Unlock since not queued for PI level
	SETZRO PINTL,(PKT)	; Indicate interface didn't take it.
	POP P,T1		; Restore error code
IFN MNET,<CALLRET ICMERR>	; Record the ICMP error & release pkt

	JN PPROG,(PKT),SNDPKX	; Pkt should be retransmitted. Save it.
	CALL RETPKT

SNDPKX:	RET

; SNDLCL	Attempt to send the packet via the "bypass".

; T1/	Destination address
;	CALL SNDLCL
;Ret+1:	Always, PKT .ne. 0 Cannot bypass; T1 = 0, bypassed


SNDLCL:	MOVE T4,T1		; Keep address here in case can't bypass

	XMOVEI T2,LCLPKT(PKT)	; Pointer to Local network part of packet
	JE PPROG,(PKT),SNDLC4	; No need to copy if no ACK expected

; Since we have to make a copy of the packet, try a few places to get
; the storage.  First, if it will fit, try to get a real, full-size IMP
; input buffer.  If that fails, go through the overhead of getting the
; space from free storage.  If that fails, give it to the IMP.

	LOAD T1,PIPL,(PKT)	; Header length in bytes
	ADDI T1,3+PKTELI*4	; Packet size in bytes, rounded up
	ASH T1,-2		; Packet size in full words
	MOVEI T3,-PKTELI+MAXLDR(T1) ; Size w/o "local info"
	CAMLE T3,MAXWPM		; Fit in Input buffer?
	  JRST SNDLC2		; No, get free storage
	JRST SNDLC0		; Off to resident code
	RESCD			; Prevent page fault while PIOFF
SNDLC0:	PIOFF			; Get unique access to IMP buffers
	SKIPG INTNFI		; Is there an IMP buffer available?
	  JRST SNDLC1		; No.  Try something else

; Use input buffer

	SOSL INTNFI		; Count down number left
	SKIPN T4,INTFRI		; Grab the first one
	  INBUG(HLT,<INTLC0: INT buffer list fouled.>,INTGW2)
	LOAD T3,NBQUE,(T4)	; Get next one after that
	SETSEC T3,INTSEC	; Make extended address
	MOVEM T3,INTFRI		; Make that the new head of the list
	SETZRO NBQUE,(T4)	; Dequeue it from others
	PION			; Free list is stable now
	PUSH P,.NBHDR(T4)	; Save free storage word
	PUSH P,T4		; Save IMP-style pkt ptr
	XMOVEI T3,-LCLPKT(T4)	; Setup for XBLTA
	XMOVEI T2,0(PKT)	; Source pointer. T1 has word count.
	CALL XBLTA		; Do the appropriate BLT
	POP P,T2		; Get back IMPDV-style pointer
	POP P,.NBHDR(T2)	; Restore buffer size
	JRST SNDLC5		; Go queue for receive side
SNDLC1:	PION			; Not going to fiddle with IMP queue

; No free input buffers, try internet free storage

SNDLC2:	PUSH P,T4		; Save address around call
	PUSH P,T1		; Save size around call
	CALL GETBLK		; Get a block of free storage
	POP P,T2		; Number of words in the block
	POP P,T3		; Address
	EXCH T1,T3		; 1/address, 2/size, 3/pkt
	JUMPE T3,R		; Couldn't.  Send thru interface anyway
	SETZRO PFLGS,(T3)	; Clear all internal flags

	CAME T2,INTXPW		; Is this a max sized packet?
	  JRST SNDLC3		; No
	SETONE PFSIZ,(T3)	; Yes.  Remember it can be an in buffer.
SNDLC3:
	MOVE T1,T2		; Size to T1
	PUSH P,PKTFLG(T3)	; Save PFSIZ bit from the BLT
	PUSH P,T3		; Save pkt ptr
	XMOVEI T2,0(PKT)	; First source word
	CALL XBLTA		; Do the appropriate BLT
	POP P,T2		; Get back pkt ptr
	POP P,PKTFLG(T2)	; Restore the PFSIZ bit
	ADDI T2,LCLPKT		; Compute pointer to ARPA leader start

SNDLC4:	CALL INTLKB		; Lock down so RCVGAT can unlock it.
	SETZRO NBQUE,(T2)	; Clear pointer


; Place the packet on the gateway input queue for the dispatcher
; T2/ (ext) address of packet at PKTELI-MAXLDR (LCLPKT)

SNDLC5:	PUSH P,T2
	MOVX T1,PT%BYP		; Queued for input
	TDNE T1,INTTRC		; Want trace?
	  CALL PRNPKI		; Yes
	POP P,T2
	PIOFF			; Turn off IMP interrupts and scheduling
	MOVE T3,INTIBI		; Get 0 or current list
	JUMPN T3,SNDLC6		; Jump if queue not empty
	MOVEM T2,INTIBO		; Was empty.  This is only item now.
	SKIPA			; Go set input pointer too.
SNDLC6:	  STOR T2,NBQUE,(T3)	; Set queue pointer in packet too
	MOVEM T2,INTIBI		; Set new input pointer
	AOS INTFLG		; Cause gateway to run (more)
	PION

	SETZ T1,		; Packet has been disposed of
	RET
	SWAPCD

; SNDGAB and SNDGAC (PKT)	; Fill in header fields

;PKT/	Extended packet address
;	CALL SNDGAB or SNDGAC
;Ret+1:	Always, with fields filled in


SNDGAB:	SETZ PKTQ(PKT)		; Zero queue
	SETZRO PFLGS,(PKT)	; Zero flags

SNDGAC:	SETZRO PICKS,(PKT)	; Clear Internet checksum field
	CALL INTCKS		; Compute Internet checksum
	STOR T1,PICKS,(PKT)	; Enter in header
	LOAD T1,PIPL,(PKT)	; Packet length in bytes
	ADDI T1,3+4*<PKTELI-LCLPKT> ; Length of IMPPHY portion
	ASH T1,-2		; Convert to words, round up
	STOR T1,NBBSZ,+LCLPKT(PKT) ; Put in pkt for use elsewhere
	RET

; Receive a packet from all networks

;	CALL RCVGAT
;Ret+1:	Always.  PKT has pointer to packet or 0 if none available


	RESCD

RCVGAT::
IFN MNET,<SAVP1>

	STACKL <<IPOPA,↑D8>> ; Args for option processing

SRP==0		; Pointer before our sending interface's address, or 0
SRC==1		; Route option code (LSROPT or SSROPT)
RRTP==2		; Pointer before our sending interface's address, or 0

; Top of loop ...

RCVGAL:	PIOFF
	MOVE PKT,INTIBO		; Get input queue output pointer
	JUMPE PKT,RCVGAY	; No packets queued
	LOAD T1,NBQUE,(PKT)	; Get successor, if any.
	JUMPN T1,RCVGAN		; Queue not about to run dry
	SETZM INTIBI		; Make empty queue
	SKIPA
RCVGAN:	  SETSEC T1,INTSEC	; Make extended address
	MOVEM T1,INTIBO		; Set new output pointer
	PION
	JRST RCVGA0

	SWAPCD

RCVGA0:	SETZRO NBQUE,(PKT)	; Packet not in a queue

	PUSH P,PKT
	SUBI PKT,LCLPKT
	SETZRO PLCLO,(PKT)	; Packet came from net
	MOVX T1,PT%RGW		; Packet received from local net
	TDNE T1,INTTRC		; Want trace?
	  CALL PRNPKI		; Yes
	POP P,PKT

	LOAD T2,NBBSZ,(PKT)	; Super size packets?
	CAMLE T2,MAXWPM
	 INBUG(HLT,<Internet input pkt smashed>,INTGW1)

	JE PFSIZ,<-LCLPKT>(PKT),RCVGAO ; Not full size means came on bypass
	MOVE T3,MAXWPM		; Reset local length to "full size"
	STOR T3,NBBSZ,(PKT)	; Which is right for input buffer
RCVGAO:

	PUSH P,T2		; Save packet size
	MOVE T1,PKT		; Pointer to the buffer again
	CALL INTULK		; Unlock packet
	POP P,T2		; Get back number or words in packet
	SUBI PKT,LCLPKT		; Return standard Internet PKT pointer
	SETZM PKTQ(PKT)		; Indicate that PKT is not queued

	; Fall through with length in T2

; Check to see that all of the packet has been received.

	LOAD T1,PIPL,(PKT)	; Internet total length in bytes
	ADDI T1,3		; Round up
	ASH T1,-2		; Number of words required
	CAMLE T1,T2		; Got it all?
	 JRST RCVGA9		; No.  Flush it.

; Check to see if it is ok to look at the Internet leader:

RCVGA1:	LOAD T1,PIVER,(PKT)	; Internet Version
	CAIE T1,.INTVR		; Right Internet Version?
	 JRST RCVGA9		; No.  Flush it.
	CALL INTCKS		; Compute the checksum
	JUMPN T1,RCVGA9		; Jump if it is bad

; Process IP options

	XMOVEI T1,IPOPA		; Option arguments
	CALL IPOPT		; Process options
	  JRST RCVGA4		; Option error

; Find where to send packet (may have been changed by routing option)

	LOAD T1,PIDH,(PKT)	; Get 32-bit internet destination

; Check if packet is to this host, if so deliver, else forward it

	SKIPN SRP+IPOPA		; Must forward if it has a route option
IFE MNET,<CAME T1,INETID>	; Is it to me?
IFN MNET,<CALL LCLHST>		; Is it one of us?
	   JRST RCVGA6		; No, packet to be forwarded
	    JRST RCVGA7		; Yes, deliver a packet to host


; Option problem

RCVGA4:	HRRZ T1,T2		; Error code or pointer?
	TLNN T2,<-1>		; Skip if <class,,error> code
	  MOVX T1,<PP%PTR,,ICM%PP> ; This is error for pointer in T2

; Cannot send packet, ICMP error code in T1

	PUSH P,T2		; Save info and
	PUSH P,T1		; ICMP error code while
	MOVX T1,PT%KIA		; Trace packet
	TDNE T1,INTTRC		; Want trace?
	  CALL PRNPKI		; Yes
	POP P,T1		; Restore ICMP error code
	POP P,T2		; and info
	CALL ICMERR		; Report error (maybe free packet)
	JRST RCVGAL		; Loop back for another packet


; The packet is not to be processed on this host.  Forward it (to T1/)

RCVGA6:	SKIPE INTSCR
	 JRST RCVGA9		; Only the other GW can do the fwd-ing

	SETZRO PPROG,(PKT)	; Packet storage not to be saved for ACK

	LOAD T2,PITTL,(PKT)	; Time to live
	SUBI T2,1		; Reduce by processing "time"
	STOR T2,PITTL,(PKT)	; Store new time to live
	JUMPLE T2,RCVGA9	; Flush if packet now dead

	CALL SNDGA1		; Send packet to address in T1

	JRST RCVGAL		; Go process next packet

; Packet is for (one of) this host's address(es).

RCVGA7:	SKIPN T4,RRTP+IPOPA	; Check if Record route
	  JRST RCVGA8		; No, skip following

; Have to insert host address for routing option

IFE MNET,<PUSH P,T3>		; Save register
	LOAD T3,PIDH,(PKT)	; Us
	CALL INSHST		; Insert host name
; Should not be any remaining source routing if pkt to be delivered
;	SKIPE T4,SRP+IPOPA	; If Source route
;	  CALL INSHST		; Insert host name
IFE MNET,<POP P,T3>		; Restore register
RCVGA8:

; See if packet is a fragment

	JE <PIMF,PIFO>,(PKT),RCVGAX ; Not a fragment, give to dispatcher
	CALL RCVFR		; Process fragment (and queue)
	JUMPN PKT,RCVGAX	; Packet was reassembled, to dispatcher
	JRST RCVGAL		; Fragment was queued, get next packet



; Something bad about this packet.  Flush it.

RCVGA9:	AOS BADPCT		; Count bad packets received
	MOVX T1,PT%XX5		; Code for "Flushed by IP"
	TDNE T1,INTTRC		; Want trace?
	  CALL PRNPKI		; Yes
	CALL RETPKT		; Return space to free storage
	JRST RCVGAL		; Hope for better luck on next packet

	RESCD
RCVGAY:	PION
RCVGAX:

..X=.				; Logically clean up here, but the
	RESTORE			; Arg block stays until RET
IFN <..X-.>,<PRINTX ? RCVGAX: Stack clobbered>
	PURGE SRP,SRC,RRTP,..X

	RET

	SWAPCD
; Fragment IP packet

;T1/	Host (0 if RPI)
;T2/	Routine (if not multinet)
;T3/	Maximum packet size for the appropriate interface
;P1/	NCT address (If multinet)
;PKT/	Packet address
;	CALL SNDFR
;Ret+1:	Always, pkt passed to net or released if error (and PINTL+PPROG=0)

; Local variables
; BD	Data length for first fragment (b)
; BO	Original data offset (b)
; CNT	A count of option bytes in header left to process.
; DCT	Number of data octets remaining in original packet
; DPT	Address in original packet for next data to be copied
; FFR	Address of packet containing first fragment, or zero if none
; FRO	Fragment offset
; LPK	Extended address of the (long) packet being fragmented.
; MAXSIZ Maximum PIPL length for fragment.
; OIN	Byte pointer into original packet for next option byte (T2)
; OLB	Option length
; OOT	Byte pointer into second fragment for next option byte (T3)
; OPT	Option code
; SFR	Address of packet containing second fragment (containing
;	header & squeezed options), or zero if none
;	NB: PPROG is set in this packet to make sure it stays
;	around until all fragments have been generated;  it is
;	then cleared & if PINTL is zero, the packet is freed
; TPK	If original PKT has PPROG zero, then PKT else zero [we RETPKT it].

SNDFR:	STACKL <DPT,FFR,FRO,MAXSIZ,OIN,OOT,SFR,TPK,DCT>
	LOCAL <BDOL,BOOP,LPCT>	; Locals shouldn't overrun P1
IFLE	P1-LPCT,<PRINTX	SNDFR -- Overrunning NCT with local variables>
BD==:BDOL
BO==:BOOP
LPK==:LPCT
	PUSH P,T3
	PUSH P,T2
	PUSH P,T1
	PUSH P,PKT		; Must be saved
	SETZM FFR		; Initialize
	SETZM SFR
	MOVE LPK,PKT
	MOVEM T3,MAXSIZ		; Maximum PIPL for local network
	SETZM TPK		; Assume PPROG 1 (save PKT)
	JN PPROG,(PKT),SNDFRB
	MOVEM PKT,TPK		; Release PKT when done
SNDFRB:
; Check if fragmention not allowed or Time to Live about to expire

	JN PIDF,(PKT),[ MOVX T1,PT%KDF ; Killed due to fragmentation
			TDNE T1,INTTRC	; Want trace?
			  CALL PRNPKI	; Yes
			MOVX T1,<DU%FRG,,ICM%DU> ; Error message too
			CALL ICMERR
			JRST SNDFWX]   ; Not allowed, lose
	LOAD T1,PITTL,(PKT)
	CAIG T1,2		; One for fragmentation & 1 left to send
	  JRST [MOVX T1,PT%KPT	; Killed due to time out
		TDNE T1,INTTRC	; Want trace?
		  CALL PRNPKI	; Yes
		MOVX T1,<TE%TTL,,ICM%TE>; Error message too
		CALL ICMERR
		JRST SNDFWX]	; Lose

; Compute storage required for fragment

	LOAD T2,PIDO,(LPK)	; Data offset (w)
	MOVE BO,T2
	ASH BO,2		; Data offset (b)
	MOVE BD,MAXSIZ		; Max PIPL allowed
	SUB BD,BO
	ANDI BD,777770		; Data octets (b)

	MOVE T1,BD
	ASH T1,-2		; Data (ew)
	ADDI T1,PKTELI(T2)	; Packet length (w)
	PUSH P,T1		; Save for copy
	CALL GETBLK
	MOVE PKT,T1		; First fragment address (or 0)
	POP P,T1		; Copy length (w)
	JUMPLE PKT,[	MOVE PKT,(P)	; Original PKT
			MOVX T1,PT%KFS	; Not enough room
			TDNE T1,INTTRC	; Want trace?
			  CALL PRNPKI	; Yes
			JRST SNDFRW]
	MOVE T2,LPK		; Original packet
	MOVE T3,PKT		; First fragment
	CALL XBLTA		; Copy local+header+options+data
	MOVEM T2,DPT		; Next data address
	LOAD T1,PIFO,(PKT)	; Save initial fragment offset
	MOVEM T1,FRO
	LOAD T1,PIPL,(LPK)	; Initial packet length (b)
	SUB T1,BO		; Less header & options
	MOVEM T1,DCT		; Is initial data length (negative)
	CAMG T1,BD		; Should be greater that allowed data length
	  JRST SNDFRD		; Shouldn't get here
	MOVE T1,BD		; Another fragment required
	SETONE PIMF,(PKT)	; So set more fragments flag

SNDFRD:
	SUBM T1,DCT		; Update Remaining data octets
	MOVNS DCT		; ...
	MOVE T2,T1
	ASH T2,-3		; Fragment blocks in fragment
	ADDM T2,FRO		; Next fragment offset
	ADD T1,BO		; Packet length (b)
	STOR T1,PIPL,(PKT)

	LOAD T1,PITTL,(PKT)	; Reduce time to live in first
	SUBI T1,1		; fragment
	STOR T1,PITTL,(PKT)

	CALL SNDGAB		; Clear flags & set checksum

	SKIPG DCT		; Anything left?
	 JRST SNDFRV		; No, all done
	MOVEM PKT,FFR		; Save frist fragment until check options

; Build second fragment squishing options

	MOVE T1,MAXSIZ
	ASH T1,-2		; (w)
	ADDI T1,PKTELI
	CALL GETBLK
	SKIPG PKT,T1
	  JRST [	MOVE PKT,(P)	; Original PKT
			MOVX T1,PT%KFS	; Not enough room
			TDNE T1,INTTRC	; Want trace?
			  CALL PRNPKI	; Yes
			JRST SNDFRW]
	MOVEI T1,<<MINIHS/4>+PKTELI> ; Local plus minimum internet header
	MOVE T2,LPK		; From original packet
	MOVE T3,PKT		; Into second fragment
	CALL XBLTA

; T2 is now address of first original option byte & T3 is where they go
; Selectively copy options, if present

	SETZ T1,		; In case branch
OLB==:BDOL
OPT==:BOOP
CNT==:LPCT
	LOAD CNT,PIDO,(LPK)	; Original header+option length (w)
	SUBI CNT,<MINIHS/4>	; Minumum header size (w)
	JUMPLE CNT,SNDFRO	; No options

	ASH CNT,2		; # option bytes present
	MOVE T1,[POINT 8,(T2)]	; Get byte pointers to
	MOVEM T1,OIN		; read old options
	MOVE T1,[POINT 8,(T3)]	; and
	MOVEM T1,OOT		; write those copied
; Process next option

SNDFRG:	ILDB OPT,OIN		; Get option code
	CAIE OPT,ENDOPT		; End of options - go align
	 CAIN OPT,ENDOPT+CPYOPT	; Watch out!
	  JRST SNDFRN
	CAIN OPT,NOPOPT		; NOP - drop it
	  JRST SNDFRL
	CAIN OPT,NOPOPT+CPYOPT	; Watch out! (let the next IP die)
	  JRST SNDFRK

; Option with length
	ILDB OLB,OIN		; Get option length
	CAIL CNT,2		; Was that a valid byte?
	 CAMGE CNT,OLB		; Make sure have enough bytes left
	  JRST SNDFRM		; Error, partial option

; Check if to copy option into all fragments
	TRNN OPT,CPYOPT		; Check copy on fragmentation flag
	  JRST SNDFRH		; Not to be copied
	IDPB OPT,OOT		; Copy option code
	IDPB OLB,OOT		; and option length
SNDFRH:
	SUB CNT,OLB		; Option bytes beyond this option
	ADDI CNT,1		; Will count 1 at end
	SUBI OLB,2		; Count down length byte
	JUMPLE OLB,SNDFRL	; Beware 2 byte option
SNDFRI:	ILDB T1,OIN		; Get next octet
	TRNE OPT,CPYOPT		; Check if copying
	  IDPB T1,OOT		; Yes
	SOJG OLB,SNDFRI		; Loop if more in option
	CAIA
SNDFRK:	  IDPB OPT,OOT		; Copy NOP...
SNDFRL:
	SOJG CNT,SNDFRG		; Loop if another option
	JRST SNDFRN

; Error in options
SNDFRM:	CALL RETPKT		; Get rid of bad packet
	MOVE PKT,(P)		; Original packet
	MOVX T1,PT%KIO		; Error (not killing it though)
	TDNE T1,INTTRC		; Want trace?
	  CALL PRNPKI		; Yes
	JRST SNDFRW		; Give up

; Align options on word boundary
SNDFRN:	SETZ T2,		; Make sure padding is zero
	IDPB T2,OOT
	IDPB T2,OOT
	IDPB T2,OOT
	IDPB T2,OOT		; and leave it in free word
	HRRZ T1,OOT		; RH has # words of options
	MOVEI T2,<MINIHS/4>(T1)
	STOR T2,PIDO,(PKT)	; New Data offset (w)
SNDFRO:
; Update PIPL and copy data, T1 (new) option length (w), T3 Adr of first opt

	ADD T3,T1		; Where to copy to

	LOAD T4,PIDO,(PKT)	; New data offset (w)
	ASH T4,2		; (b)
	MOVE T1,MAXSIZ		; Max packet length (b)
	SUB T1,T4		; Max data length (b)
	ANDI T1,777770		; In fragment blocks
	CAMLE T1,DCT		; Number of bytes left
	  MOVE T1,DCT		; Last fragment
	SUBM T1,DCT		; update Data bytes left
	MOVNS DCT		; ...
	ADD T4,T1		; New data+header (b)
	STOR T4,PIPL,(PKT)	; Packet length

	ADDI T1,3		; Round octets up to
	ASH T1,-2		; Data words to copy

	MOVE T2,FRO		; Fragment offset for second frag
	STOR T2,PIFO,(PKT)	; Into header
	MOVE T2,T1
	ASH T2,-1		; Fragment blocks
	ADDM T2,FRO

	MOVE T2,DPT		; Where to copy from
	CALL XBLTA		; From original to second fragment
	MOVEM T2,DPT		; For next time

	LOAD T1,PITTL,(PKT)	; Reduce time to live
	SUBI T1,1		; by fragmentation
	STOR T1,PITTL,(PKT)

	SETZM PKTQ(PKT)
	SETZRO PFLGS,(PKT)

	SKIPG DCT		; Need another fragment?
	  JRST SNDFRQ		; No, second is the last
	SETONE PPROG,(PKT)	; We keep this PKT to copy headers & options
	MOVEM PKT,SFR		; Save packet address for copy
	SETONE PIMF,(PKT)	; There are more fragments
SNDFRQ:
	CALL SNDGAC		; Set checksum
; Send first two fragments

	MOVEM PKT,LPCT		; Save second packet
	SETZ PKT,
	EXCH PKT,FFR		; While send first

	MOVX T1,PT%IFR		; Fragment created
	TDNE T1,INTTRC		; Want trace?
	  CALL PRNPKI		; Yes

	MOVE T1,-1(P)		; Restore regs
	MOVE T2,-2(P)
	MOVE T3,-3(P)
	CALL SNDPKT		; Fragment to local interface

	MOVE PKT,LPCT		; Now send second
	MOVX T1,PT%IFR		; Fragment created
	TDNE T1,INTTRC		; Want trace?
	  CALL PRNPKI		; Yes
	MOVE T1,-1(P)		; Restore regs
	MOVE T2,-2(P)
	MOVE T3,-3(P)
	CALL SNDPKT		; Fragment to local interface
	SKIPG DCT		; Anything left?
	 JRST SNDFRX		; All done

; Create third through last fragments

SNDFRS:	MOVE T1,SFR		; Packet with header+options
	LOAD T4,PIDO,(T1)	; Data offset (w)
	ASH T4,2		; (b)
	MOVE T1,MAXSIZ		; Max packet length (b)
	SUB T1,T4		; Max data length (b)
	ANDI T1,777770		; In fragment blocks
	CAMLE T1,DCT		; Number of bytes left
	  MOVE T1,DCT		; Last fragment
	SUBM T1,DCT		; Data bytes left
	MOVNS DCT		; ...

	PUSH P,T1
	ADDI T1,<<PKTELI*4>+3>(T4) ; Local+round up+header
	ASH T1,-2		; Buffer length (w)
	CALL GETBLK
	SKIPG PKT,T1
	  JRST [	POP P,(P)	; Drop T1
			MOVE PKT,(P)	; Original PKT
			MOVX T1,PT%KFS	; Not enough room
			TDNE T1,INTTRC	; Want trace?
			  CALL PRNPKI	; Yes
			JRST SNDFRW]
	MOVE T3,PKT		; Empty buffer
	MOVE T2,SFR		; Packet with local+header+options
	LOAD T1,PIDO,(T2)	; Length header+options (w)
	ADDI T1,PKTELI		; Plus local
	CALL XBLTA

	POP P,T1		; Data length (b)
	LOAD T4,PIDO,(PKT)	; Header length (w)
	ASH T4,2		; (b)
	ADD T4,T1
	STOR T4,PIPL,(PKT)	; New length

	ADDI T1,3		; Data bytes are
	ASH T1,-2		; Rounded up words

	MOVE T2,FRO		; Fragment offset
	STOR T2,PIFO,(PKT)	; Into packet
	MOVE T2,T1
	ASH T2,-1		; Fragment blocks
	ADDM T2,FRO		; Next fragment offset

	MOVE T2,DPT		; Next data address
	CALL XBLTA
	MOVEM T2,DPT		; For next fragment

	MOVE T2,LPK		; Get PIMF from
	LOAD T4,PIMF,(T2)	; original packet
	SKIPLE T4,DCT		; If more data
	  MOVEI T4,1		; Set PIMF
	STOR T4,PIMF,(PKT)	; Store result

	CALL SNDGAB		; Clear flags & set checksum

; (May enter here with first fragment in PKT, if fragmentation wasn't needed)

SNDFRV:	MOVX T1,PT%IFR		; Fragment created
	TDNE T1,INTTRC		; Want trace?
	  CALL PRNPKI		; Yes

	MOVE T1,-1(P)		; Restore regs
	MOVE T2,-2(P)
	MOVE T3,-3(P)
	CALL SNDPKT		; Fragment to local interface

	SKIPLE DCT		; More data?
	  JRST SNDFRS		; Yes
	JRST SNDFRX		; No, all done
; Error, drop original packet

SNDFRW:	MOVE PKT,(P)		; Restore PKT
	JN PPROG,(PKT),SNDFRX	; Pkt should be retransmitted. Save it.
	CALL RETPKT
;;; here after an ICMP error (storage already returned)
SNDFWX:	SETZM TPK		; Can only free it once

SNDFRX:	SKIPLE PKT,FFR		; Still have first fragment (had error)?
	  CALL RETPKT		; Yes, return it

	SKIPG PKT,SFR		; Have second fragment?
	  JRST SNDFRY		; No ??
	SETZRO PPROG,(PKT)	; Were done with it
	JN PINTL,(PKT),SNDFRY	; Still in use by net?
	  CALL RETPKT		; No, both done so return packet
SNDFRY:

	SKIPE PKT,TPK		; Release original PKT?
	  CALL RETPKT		; Yes, PPROG was zero

	POP P,PKT
	POP P,T1
	POP P,T2
	POP P,T3	
	RESTORE
	RET

	PURGE BD,BO,CNT,LPK,OLB,OPT ; Purge temp reg names

; Process a fragment which was just received	or	Flush timedouts

;	MOVE PKT,24-bit fragment packet address
;	CALL RCVFR					CALL RCVFLS
;Ret+1:	Always.  PKT has 24-bit address of reassembled packet, or 0

; While scanning received fragment queue (INTRAQ), drop any packets
; whose Time To Live has expired.

; Argument & return value
;PKT	Packet which just arrived (0 if packet has been queued)
;	During scan, 0 if packet has been processed (but can't RA)
;		<0	24-bit address of packet to be RA'd
;		>0	24-bit address of fragment to be inserted
;	On return, 0 if reassembly is incomplete or the 24-bit
;	address of the reassembled packet

; Global variables:
;INTRAQ	24-bit adr of first packet in reassembly queue, or 0
;	The queue is sorted by source host (PISH), protocol
;	(PIPRO), destination host (PIDH), segment id (PISID),
;	and fragment offset (PIFO).
;INTRAN	Unique # for each packet to be RA'd; starts at 0
;	(minimizes comparisons of PISH, PIPRO, PIDH, & PISID)
;INTRAT	TODCLK time INTRAQ should be scanned for expired packets

; Local variables are:
;LPK	24-bit adr of previous packet in chain
;CPK	24-bit adr of current packet being examined (0 if end)
;SAMPKT	 0 the packet pointed to by PKT is not part of that
;	   pointed to by CPK
;	>0 the packet pointed to by PKT is part of that pointed
;	   to by CPK AND all fragments (so far) are present
;	   The value is a pointer to the fragment BEFORE the
;	   first fragment of the (reassembled) packet (e.g. a LPK)
;	<0 the packet pointed to by PKT is part of that pointed
;	   to by CPK AND all fragments (so far) are NOT present
;KPK	List of expired packets, or 0 if none
;KILLTM	TODCLK when fragment just received should be killed
;LASTFO	Last value of fragment offset (all fragments up to it
;	are present)

; Fields in the packet header are used as follows (while in INTRAQ):
;PKTQ	Chains fragments together in sorted order; it contains
;	the 24-bit packet address of the next packet in the Q
;PRXI	Contains packet RA id (from INTRAN) when in INTRAQ
;	Contains reason for being killed when in KPK list
;	When PKT<0, First fragment contains LASTFO of last fragment
;PDCT	The TODCLK time that the Time To Live expires
;PESEQ	The fragment offset of the next fragment (PIFO+(PIPL-4*PIDO)+7/8)

RCVFLS::SETZ PKT,		; Flush fragments which have timedout
RCVFR:	STACKL <LASTFO,KILLTM>
	LOCAL <LPK,CPK,SAMPKT,KPK>
	SETZB SAMPKT,KPK	; Initialize local variables
	SETZM LASTFO		; No last fragment offset
	XMOVEI LPK,INTRAQ-PKTQ	; Dummy packet at head
	MOVX T1,377777777777	; Plus infinity

; See if just dropping timed out packets

	JUMPE PKT,RCVFRA	; Yes, begin scan

; Fill in packet variables

	SETZM PKTQ(PKT)		; Not yet queued
	SETZRO PRXI,(PKT)	; No RA id

	LOAD T4,PITTL,(PKT)	; Get Time To Live
	SUBI T4,1		; Processing time here
	JUMPLE T4,RCVFRT	; Kill it now
	IMULI T4,↑D1000		; Lifetime in milliseconds
	ADD T4,TODCLK		; When to kill it
	STOR T4,PDCT,(PKT)
	MOVEM T4,KILLTM		; Save it (from PRNPKI)

	LOAD T4,PIMF,(PKT)	; To check if last fragment
	LOAD T2,PIDO,(PKT)	; Header length (w)
	ASH T2,2		; (b)
	LOAD T3,PIPL,(PKT)	; Total packet length (b)
	SUB T3,T2		; Data length (b)
	SKIPE T4		; If not last fragment
	 TRNN T3,7		; data must be multiple of 8 bytes
	  CAIA			; Ok
	   JRST RCVFRS		; Its a bad packet
	ADDI T3,7		; Round up
	ASH T3,-3		; Data length (f)
	LOAD T2,PIFO,(PKT)	; Get fragment offset
	ADD T3,T2		; Find fragment end
	STOR T3,PESEQ,(PKT)	; Save for later

	MOVEM T1,INTRAT		; Plus infinity
; See if INTRAQ is empty

	MOVE CPK,INTRAQ		; Locate first fragment
	JUMPN CPK,RCVFRC	; Begin if not empty

; Queue was empty: only entry becomes this packet & KILLTM is next scan time

	MOVEM PKT,INTRAQ	; Begin a queue
	MOVE T4,KILLTM
	MOVEM T4,INTRAT		; Next scan time
	AOSN T1,INTRAN		; Get next RA id
	 AOS T1,INTRAN		; Don't use 0 (Wow 2**36 packets??)
	STOR T1,PRXI,(PKT)

	MOVX T1,PT%QIF		; Fragment queued
	TDNE T1,INTTRC		; Want trace?
	  CALL PRNPKI		; Yes
	JRST RCVFRU		; All done


; Just want to purge expired fragments (PKT=0)

RCVFRA:	MOVEM T1,INTRAT		; Plus infinity
	SKIPN CPK,INTRAQ	; Look for empty queue
	  JRST RCVFRV		; All done
	JRST RCVFRC		; Begin with first fragment


; Move to next entry in queue

RCVFRB:	JUMPE CPK,RCVFRV	; All done
	MOVE LPK,CPK
	MOVE CPK,PKTQ(CPK)

; Process current queue entry

RCVFRC:	JUMPE CPK,RCVFRG	; Reached end of Q, may have PKT to insert

; Check if its time to kill this fragment

	LOAD T1,PDCT,(CPK)	; Get packet kill time
	CAMLE T1,TODCLK		; Its time up?
	  JRST RCVFRD		; Not yet

; Place the packet on kill list

	MOVE T1,PKTQ(CPK)	; Next packet in INTRAQ
	MOVEM T1,PKTQ(LPK)
	MOVEM KPK,PKTQ(CPK)	; Killed packet to head of kill list
	MOVE KPK,CPK
	MOVE CPK,T1
	MOVX T1,PT%KIT		; Reassembly timeout PKTPRN code
	STOR T1,PRXI,(KPK)
	JRST RCVFRC		; New current packet to process
RCVFRD:
; See if still have a PKT fragment to insert

	JUMPLE PKT,RCVFRO 	; No, just continue scan

; See if fragment should be inserted between LPK and CPK
;KILLTM=kill todclk

	LOAD T1,PRXI,(CPK)	; Get RA ids (this one is never 0)
	LOAD T2,PRXI,(PKT)	; 0 if none assigned
	CAMN T2,T1
	  JRST RCVFRE		; Skip 4 tests (PRXI set)

	LOAD T1,PISH,(CPK)	; Get source addresses
	LOAD T2,PISH,(PKT)
	CAMLE T2,T1
	  JRST RCVFRB		; Cannot insert yet
	CAME T2,T1
	  JRST RCVFRH		; Insert it here, may have RA id

	LOAD T1,PIPRO,(CPK)	; Get protocols
	LOAD T2,PIPRO,(PKT)
	CAMLE T2,T1
	  JRST RCVFRB		; Cannot insert yet
	CAME T2,T1
	  JRST RCVFRH		; Insert it here, may have RA id

	LOAD T1,PIDH,(CPK)	; Get destination addresses
	LOAD T2,PIDH,(PKT)
	CAMLE T2,T1
	  JRST RCVFRB		; Cannot insert yet
	CAME T2,T1
	  JRST RCVFRH		; Insert it here, may have RA id

	LOAD T1,PISID,(CPK)	; Get packet ids
	LOAD T2,PISID,(PKT)
	CAMLE T2,T1
	  JRST RCVFRB		; Cannot insert yet
	CAME T2,T1
	  JRST RCVFRH		; Insert it here, may have RA id

; Just found another fragment, must be sure to set SAMPKT & LASTFO & PDCT

	LOAD T1,PRXI,(CPK)	; Get RA id
	STOR T1,PRXI,(PKT)	; For new fragment

RCVFRE:	MOVE T4,KILLTM
	STOR T4,PDCT,(CPK)	; Update kill time
	LOAD T1,PIFO,(CPK)	; Get fragment offsets
	LOAD T2,PIFO,(PKT)
	CAMLE T2,T1
	  JRST RCVFRJ		; Cannot insert yet, but part of packet
	CAME T2,T1
	  JRST RCVFRI		; Insert it here, have RA id

; Just found a duplicate, discard smaller

	LOAD T2,PESEQ,(PKT)	; Get end fragment offsets
	LOAD T1,PESEQ,(CPK)
	CAMG T2,T1
	  JRST RCVFRF		; Kill PKT

; New arrival is longer than old, swap new into queue

	MOVE T1,PKTQ(CPK)	; Tail
	MOVEM T1,PKTQ(PKT)
	MOVEM PKT,PKTQ(LPK)
	MOVX T1,PT%QIF		; Queued for reassembly
	TDNE T1,INTTRC		; Want trace?
	  CALL PRNPKI		; Yes
	EXCH CPK,PKT

; Kill copy pointed to by PKT

RCVFRF:	MOVEM KPK,PKTQ(PKT)
	MOVE KPK,PKT
	SETZ PKT,		; PKT gone
	MOVX T1,PT%KDP		; Duplicate fragment rec'd & killed
	STOR T1,PRXI,(KPK)
	JRST RCVFRO		; Go process current fragment
; Reached end of INTRAQ (CPK=0), may still have PKT to process

RCVFRG:	JUMPLE PKT,RCVFRV	; Packet already processed

; Insert PKT between LPK and CPK, may have RA id

RCVFRH:	JN PRXI,(PKT),RCVFRI	; Already have RA id for fragment?
	AOSN T1,INTRAN		; Get next RA id
	 AOS T1,INTRAN		; Don't use 0 (really had 2**36 packets??)
	STOR T1,PRXI,(PKT)
RCVFRI:				; Now have RA id

	MOVEM PKT,PKTQ(LPK)	; Insert PKT between LPK and CPK
	MOVEM CPK,PKTQ(PKT)
	MOVE CPK,PKT
	MOVX T1,PT%QIF		; Fragment queued
	TDNE T1,INTTRC		; Want trace?
	  CALL PRNPKI		; Yes
	SETZ PKT,		; Fragment processed

; See if first fragment of a packet, if so, set SAMPKT & LASTFO

RCVFRJ:	JUMPN SAMPKT,RCVFRL	; Cannot be first fragment of packet
	MOVE SAMPKT,LPK		; Flag is adr before first (to unlink)
	JE PIFO,(CPK),RCVFRK	; Jump if first fragment
	TLO SAMPKT,400000	; First fragment missing, cannot RA
RCVFRK:	LOAD T1,PESEQ,(CPK)	; Next fragment offset
	MOVEM T1,LASTFO		; for continuity check
	JRST RCVFRB
RCVFRL:
; Process current fragment

RCVFRO:	LOAD T1,PDCT,(CPK)	; Fragment timeout
	CAMG T1,INTRAT		; Find minimum
	  MOVEM T1,INTRAT	; For next scan

	JUMPLE SAMPKT,RCVFRB	; Not part of a RA'able packet

	LOAD T1,PRXI,(CPK)	; Get RA ids
	LOAD T2,PRXI,(LPK)
	CAMN T1,T2
	  JRST RCVFRP
	SETZM SAMPKT		; End of packet, not reassemblable
	JRST RCVFRB		; Go for next in queue
RCVFRP:

; Check if current fragment is next one required

	LOAD T1,PIFO,(CPK)	; Its fragment offset must
	CAMLE T1,LASTFO		; be less than or equal to this offset
	  JRST RCVFRQ		; Missing fragment

	LOAD T1,PESEQ,(CPK)	; Next fragment needed
	MOVEM T1,LASTFO
	JRST RCVFRR

RCVFRQ:	TLO SAMPKT,400000	; Cannot RA
RCVFRR:

; Update kill time in fragments to that of recently arrived fragment

	MOVE T4,KILLTM
	STOR T4,PDCT,(CPK)

	JUMPLE SAMPKT,RCVFRB	; Don't look for last fragment
	JN PIMF,(CPK),RCVFRB	; Not last fragment

; Have all fragments for reassembly, remove them from the INTRAQ

	MOVE LPK,SAMPKT		; Points before first
	MOVE PKT,PKTQ(LPK)	; First fragment for reassembly
	LOAD T1,PESEQ,(CPK)	; Number of fragments in packet
	STOR T1,PRXI,(PKT)	; saved for RA
	TLO PKT,400000		; Flag it so don't try to insert
	MOVE T1,PKTQ(CPK)
	MOVEM T1,PKTQ(LPK)	; Relink INTRAQ
	SETZM PKTQ(CPK)		; Last fragment for reassembly
	MOVE CPK,T1		; Next fragment to scan
	SETZ SAMPKT,		; Just check timeouts in rest of scan
	JRST RCVFRC		; Go for current item
; Improper packet, discard it

RCVFRS:	SKIPA T1,[PT%KIP]	; Code for invalid packet

; Argument packet Time To Live just expired, thow it away

RCVFRT:	  MOVX T1,PT%KPT	; Code for Time To Live expired
	STOR T1,PRXI,(PKT)
	MOVEM PKT,KPK		; Argument packet has expired

RCVFRU:	SETZ PKT,		; Nothing to be returned

; All done with scan of queue, return any killed packets

RCVFRV:	MOVEM PKT,LASTFO	; Save return value over local variable
	JUMPE KPK,RCVFRX	; Nothing to kill
RCVFRW:	MOVE PKT,KPK		; Head of expired packet queue
	MOVE KPK,PKTQ(PKT)	; Get tail
	SETZM PKTQ(PKT)

	LOAD T1,PRXI,(PKT)	; Reason for discarding
	TDNE T1,INTTRC		; Want trace?
	  CALL PRNPKI		; Yes; Finished with packet
	CALL RETPKT		; Release storage

	JUMPN KPK,RCVFRW	; If more go back

RCVFRX:	MOVE PKT,LASTFO		; Get return value back
; If PKT < 0, then reassemble fragments

RCVRA:	JUMPGE PKT,RCVRAX	; PKT = 0 means nothing to RA
	TLZ PKT,400000		; Get first fragment address
	MOVE KPK,PKT		; All fragments will be killed
	SETZ PKT,		; Nothing to return
	MOVE CPK,KPK		; To move through fragments

; Get storage for reassembled packet

	LOAD T1,PIDO,(KPK)	; Internet header (w)
	LOAD T2,PRXI,(KPK)	; Number of fragment blocks
	ASH T2,1		; at 2 words each
	ADDI T1,PKTELI(T2)	; Add them and local overhead

	CALL GETBLK		; Get storage for all
	JUMPN T1,RCVRAF		; Got enough

; Not enough space, kill fragments off

	MOVX T1,PT%KIS		; Code for killed due to no space
RCVRAE:	STOR T1,PRXI,(CPK)	; Code into fragment
	MOVE CPK,PKTQ(CPK)	; Move to next
	JUMPN CPK,RCVRAE	; Back for all fragments
	JRST RCVFRV		; Back to kill them off

; Have enough room, copy first fragment into packet

RCVRAF:	MOVE PKT,T1		; Combined packet
	SETZM PKTQ(PKT)
	SETZRO PFLGS,(PKT)
	MOVE SAMPKT,PKT		; Working address in combined packet
	ADDI SAMPKT,PKTSII	; but skip flags

	MOVE T2,KPK		; Start with complete first fragment
	ADDI T2,PKTSII		; but skip flags
	LOAD T1,PESEQ,(KPK)	; Data length
	MOVEM T1,LASTFO		; Next fragment offset
	ASH T1,1		; in words
	LOAD T4,PIDO,(KPK)	; Header length (w)
	ADDI T1,PKTELI-PKTSII(T4) ; Add local - flags + header + data
	JRST RCVRAP		; Into loop

RCVRAL:	MOVE CPK,PKTQ(CPK)	; Get next fragment
	JUMPE CPK,[CALL RETPKT	; Error, missing last fragment??
		SETZ PKT,	; Nothing to return
		MOVX T1,PT%KIT	; Code for impossible error
		JRST RCVRAE]
	LOAD T2,PIDO,(CPK)	; Header length (w)
	MOVE T3,LASTFO		; Next fragment to copy
	LOAD T1,PESEQ,(CPK)	; Data end
	LOAD T4,PIFO,(CPK)	; Data start

; Worry about overlap - beginning of fragment may already be copied

	CAMGE T3,T1		; If this fragment adds some
	  MOVEM T1,LASTFO	; Save new last fragment

	SUB T3,T4		; Find # fragments of overlap
	JUMPL T3,[CALL RETPKT	; Error, missing fragment??
		SETZ PKT,	; Nothing to return
		MOVX T1,PT%KIT	; Code for impossible error
		JRST RCVRAE]
	ASH T3,1		; In words

	SUB T1,T4		; Data length of CPK
	ASH T1,1		; in words

	ADDI T2,PKTELI(T3)	; Increase copy offset and
	SUB T1,T3		; Decrease copy length by overlap
	JUMPLE T1,RCVRAS	; Nothing required from this fragment

	ADD T2,CPK		; Start of data address

; Copy T1 words from T2 into packet

RCVRAP:	MOVX T4,PT%DIF		; Code for IP RA'd
	STOR T4,PRXI,(CPK)

	MOVE T3,SAMPKT		; Address in packet
	ADD SAMPKT,T1		; Next address in packet
	CALL XBLTA		; Copy words

RCVRAS:	JN PIMF,(CPK),RCVRAL	; If more fragments, loop

; Done, correct internet header; find new packet length

	LOAD T1,PIPL,(CPK)	; Last fragment length (b)
	LOAD T2,PIDO,(CPK)	; Header length (w)
	ASH T2,2		; (b)
	SUB T1,T2		; Data length (b) of last fragment
	LOAD T2,PIFO,(CPK)	; Data length (f) of previous fragments
	ASH T2,3		; (b)
	ADD T1,T2		; Total data length (b)
	LOAD T2,PIDO,(PKT)	; Data offset (w)
	ASH T2,2		; (b)
	ADD T1,T2		; Total packet length (b)
	STOR T1,PIPL,(PKT)	; into packet

	SETZRO <PIMF,PIFO>,(PKT) ; Should be zero

	LOAD T1,PDCT,(PKT)	; Kill time
	SUB T1,TODCLK		; remaining
	IDIVI T1,↑D1000		; in seconds
	CAILE T1,377		; Clamp to 8 bits
	  MOVEI T1,377
	CAIGE T1,1
	  MOVEI T1,1
	STOR T1,PITTL,(PKT)	; Remaining Time To Live

	SETZRO PICKS,(PKT)	; Compute
	CALL INTCKS		; new header checksum
	STOR T1,PICKS,(PKT)

; Clear variables in header

	SETZRO PRXI,(PKT)
	SETZRO PDCT,(PKT)
	SETZRO PESEQ,(PKT)

; Have a reassembled packet to return after release fragments

	MOVX T1,PT%IRA		; Packet reassembled
	TDNE T1,INTTRC		; Want trace?
	  CALL PRNPKI		; Yes
	JRST RCVFRV		; Go kill fragments from KPK

RCVRAX:	RESTORE
	RET
	RESCD

; INTLKB		Lock both ends of an Internet packet
;			so interrupt level will not get a page fault

;T2/	Extended pointer to the IMP-style packet
;
;	CALL INTLKB
;Ret+1:	Always.  T2 preserved.

INTLKB::LOCAL <IMPPKT,PKTLIM>
	MOVEM T2,IMPPKT		; Save pointer to IMP packet

	LOAD PKTLIM,NBBSZ,(IMPPKT) ; Get size field
	CAMLE PKTLIM,MAXWPM	; OK?
	 INBUG(HLT,<INTLKB: Pkt size smashed>,INTMS1)

	ADD PKTLIM,IMPPKT	; First location following packet
	IORI PKTLIM,PGSIZ-1	; Round up to top of page
	MOVE T1,IMPPKT		; Where to start locking
IFKA <
	PUSH P,5		; TENEX PAGEM might crash these
	PUSH P,6		; depending on whether page has to be
	PUSH P,7		; swapped in.
	PUSH P,10
>
INTLK1:	PUSH P,T1		; Save core address
	CALL MLKMA		; Lock monitor address in core
	POP P,T1
	ADDI T1,PGSIZ		; Move on to next page
	CAMG T1,PKTLIM		; Done all of packet?
	 JRST INTLK1		; No.
IFKA <
	POP P,10
	POP P,7
	POP P,6
	POP P,5
>
	MOVE T2,IMPPKT		; Restore T2 as required
	RESTORE
	RET

; INTULK		Unlock both ends of an Internet packet

;T1/	Pointer to IMP-style part of packet
;
;	CALL INTULK
;Ret+1:	Always.  T1 preserved.

	RESCD
INTULK::LOCAL <IMPPKT,PKTLIM>
	MOVEM T1,IMPPKT		; Save pointer to IMP packet

	LOAD PKTLIM,NBBSZ,(IMPPKT) ; Get size field
	CAMLE PKTLIM,MAXWPM	; OK?
	 INBUG(HLT,<INTULK: Pkt size smashed>,INTUBF)

	ADD PKTLIM,IMPPKT	; First location following packet
	IORI PKTLIM,PGSIZ-1	; Round up to top of page
INTUL1:	PUSH P,T1		; Save core address
	CALL MULKSP		; Unlock monitor address
	POP P,T1
	ADDI T1,PGSIZ		; Move on to next page
	CAMG T1,PKTLIM		; Done all of packet?
	 JRST INTUL1		; No.
	MOVE T1,IMPPKT		; Restore T1 as required
	RESTORE
	RET
; IPOPT		Process IP Options - Phase 1, before routing

; T1/	Pointer to argument block: SRP,SRC,RRTP,RRTC,CURBYT,OPTP
    SRP==0	; Pointer before our sending interface's address, or 0
    SRC==1	; Route option code (LSROPT or SSROPT) [temp:see RRTC]
    RRTP==2	; Pointer before our sending interface's address, or 0
    RRTC==3	; Current byte number for RRTOPT parameter problem message
    CURBYT==4	; Current byte number for parameter problem message
    OPTP==5	; Working pointer to next option byte
    GARB==6 ;,2	; Dummy pointer/count pair
;   IPOPS==↑D8	; Size of block
; PKT/	(ext) pointer to packet
;	CALL IPOPT
;Ret+1:	  Option error, T2 has code
;Ret+2:	OK

IPOPT:	SETZM SRP(T1)		; No Source Route
	SETOM SRC(T1)		; Invaild option code
	SETZM RRTP(T1)		; No Record Route
	SETZM CURBYT(T1)	; No Parameter problem error pointer

	LOAD T2,PIDO,(PKT)	; Get size of IP header
	LSH T2,2		; In bytes
	SUBI T2,MINIHS		; Option length, bytes
	JUMPLE T2,RSKP		; Good, No options (CURBYT is 0)


	LOCAL <OPLB,REMB,ARGP>
	MOVEM T1,ARGP		; Address of argument block
	MOVEM T2,REMB		; # Option bytes to process

	MOVX T2,MINIHS		; Byte offset to options
	MOVEM T2,CURBYT(ARGP)	; First option byte
	AOS CURBYT(ARGP)	; Start with one??
	ADJBP T2,[POINT 8,PKTELI(PKT),7] ; From IP header
	MOVEM T2,OPTP(ARGP)	; Save pointer
	SETZ T2,		; No parameter problems

; Process next option from header

NXTOP:	MOVE T1,OPTP(ARGP)	; Pointer at option for subroutines
	MOVX OPLB,1		; Assume single byte option length
	LDB T4,OPTP(ARGP)	; Get option
	TRZ T4,CPYOPT		; Drop copy flag

	CAIN T4,<ENDOPT&↑-CPYOPT> ; END of options?
	  JRST DONOP		; Yes, quit

	CAIN T4,<NOPOPT&↑-CPYOPT> ; NOP?
	  JRST FINOP		; Yes, on to next
; Option with length

	MOVX T2,1		; Parameter problem - option length
	CAIGE REMB,2		; Enough remaining for length?
	  JRST DONOP		; No, error

	ILDB OPLB,OPTP(ARGP)	; Get length
	CAMLE OPLB,REMB		; Exceed remaining header length?
	  JRST DONOP		; Yes, error

	MOVE T2,CURBYT(ARGP)	; Count at option (useful parameter)

	XMOVEI T3,SRP(ARGP)
	CAIE T4,<LSROPT&↑-CPYOPT> ; Lose Source Route?
	 CAIN T4,<SSROPT&↑-CPYOPT> ; Strict Source Route?
	  CALL RUTOP
	JUMPE T3,FINOP		; Found it, T2 may indicate error

	XMOVEI T3,RRTP(ARGP)
	CAIN T4,<RRTOPT&↑-CPYOPT> ; Record Route?
	  CALL RUTOP
	JUMPE T3,FINOP		; Found it, T2 may indicate error

	XMOVEI T3,GARB(ARGP)
	CAIN T4,<TSPOPT&↑-CPYOPT> ; Time Stamp?
	  CALL DOTSP		; Yes, process it now (save T1)
	JUMPE T3,FINOP		; Found it, T2 may indicate error

; Uninteresting or unknown option
	SETZ T2,		; No parameter problem

FINOP:	JUMPN T2,DONOP		; Parameter problem
	SUB REMB,OPLB		; Bytes remaining in header
	ADDM OPLB,CURBYT(ARGP)	; Count for next option
	ADJBP OPLB,T1		; Point at next option
	MOVEM OPLB,OPTP(ARGP)	; Reset pointer
	JUMPG REMB,NXTOP	; Loop if more

DONOP:	TLNE T2,<-1>		; Non-zero left half is <class,,error>
	  SETZM CURBYT(ARGP)	; Error code will replace count
	ADDM T2,CURBYT(ARGP)	; Done processing options

	SKIPN T2		; Any errors?
	  SETZM CURBYT(ARGP)	; No errors
	MOVE T2,CURBYT(ARGP)	; Return code
	RESTORE
	SKIPN T2		; Look for error in options
	  AOS (P)		; All ok, skip return
	RET

	PURGE SRP,SRC,RRTP,RRTC,CURBYT,OPTP,GARB
; Routing Options

; T1/	Pointer at Option type code
; T2/	Count of Option type code byte
; T3/	Address for pointer & count
; T4/	Option code w/o CPYOPT
;	CALL RUTOP
;Ret+1:	Always,  Parameter problem if T2 non-zero (relative offset, or error)
;	T1/ unchanged, T3/0


RUTOP:	SKIPE (T3)		; Already have this option?
	  JRST RUTZ		; Yes, error
	DMOVEM T1,(T3)		; No, Save pointer and curbyt

	LOCAL <OPT,OPTP,OPTL,CPTR>
	PUSH P,T1
	MOVEM T1,OPTP		; Set working pointer
	MOVEM T4,OPT		; Masked option

	ILDB OPTL,OPTP		; Option length
	MOVX T2,1		; In case error
	CAIGE OPTL,7		; Header + one id
	  JRST RUTY		; Lose

	CAIN OPT,<RRTOPT&↑-CPYOPT> ; Record route?
	  JRST RUTEX		; Yes, skip following

	JN PLCLO,(PKT),RUTEX	; Jump if we generated packet

	LOAD T1,PIDH,(PKT)	; Immediate destination
IFE MNET,<CAME T1,INETID>	; To us?
IFN MNET,<CALL LCLHST>		; To one of us?
	   CAIA			; No
	    JRST RUTEX		; Yes, go look for next hop


; We received a packet for which we are not the destination
; specified in the packet destination field.  This is a route
; failure for Strict Source Routes, but is OK for Loose Routes.

	CAIE OPT,<SSROPT&↑-CPYOPT> ; Strict route?
	  JRST RUTK		; No. Ignore route option,
				; Use full routing
	MOVX T2,<DU%SRF,,ICM%DU> ; Yes, Different error message
	JRST RUTY		; For route failure

; We recieved a packet for which we are the destination
; specified in the packet destination field.

RUTEX:

; Check if the Route option has been exhausted or not.

	ILDB CPTR,OPTP		; Current pointer offset
	CAIG OPTL,(CPTR)	; Already full?
	  JRST RUTK		; Yes, ignore option, send to destination

	MOVX T2,2		; Parameter problem with pointer
	CAIGE OPTL,4-1(CPTR)	; Enough room for another entry?
	  JRST RUTY 		; No, fail

	MOVEI T2,-4(CPTR)	; Bytes to before our slot

	ADDI CPTR,4		; Update pointer
	DPB CPTR,OPTP		; In option header

	ADDM T2,1(T3)		; Updated count in case error
	ADJBP T2,OPTP		; Pointer before our sending
	MOVEM T2,OPTP		; address slot 
	MOVEM T2,(T3)		; To be filled in later

	CAIN OPT,<RRTOPT&↑-CPYOPT> ; Record route option?
	  JRST RUTX		; Yes, don't update packet destination

; Extract next destination from route and put it in packet header

	MOVX T1,17		; Unused bits
	ILDB T2,OPTP	;***	; Get id byte
	LSH T2,↑D<36-8>	;***	; Left justify
	LSHC T1,↑D8	;***	; & pack
	JUMPGE T1,.-3	;***	; 4 bytes
;	TXZ T1,<740000,,0>	; Mask to 32 bits
	STOR T1,PIDH,(PKT)	; Next destination for packet

	MOVEM OPT,1(T3)		; Save Strict/Loose code
	JRST RUTX		; Done for now, no errors

RUTK:	SETZM (T3)		; Ignore this option
	SETZM 1(T3)

RUTX:	SETZ T2,		; No errors
RUTY:	POP P,T1		; Error, T2 has <0,,relative offset>,
	RESTORE			; Or <class,,error>
	SETZ T3,		; Option processed
	RET

; Duplicate route option is an error

RUTZ:	MOVEM T2,1(T3)		; Error pointer
	SETZ T3,		; Option processed
	RET





; Second Phase 2 of route option - insert out-going host id in packet

; T3/	Host id to be inserted
; T4/	Pointer before slot
;	CALL INSHST
;Ret+1:	Always, T1,T2 preserved


INSHST:	ROT T3,↑D<4+8>		; First byte right justified
	IDPB T3,T4		; Pack them in
	ROT T3,↑D8
	IDPB T3,T4
	ROT T3,↑D8
	IDPB T3,T4
	ROT T3,↑D8
	IDPB T3,T4

	RET

; Time Stamp Option

; T1/	Pointer at TSPOPT
;	CALL DOTSP
;Ret+1:	Always,  Parameter problem if T2 non-zero (relative offset)
;	T1/ unchanged, T3/0

DOTSP:	LOCAL <OPTP,OPTL,CPTR,SAVPTR>
	PUSH P,T1		; Save arg
	MOVE OPTP,T1		; Set working pointer

	ILDB OPTL,OPTP		; Option length

	MOVX T2,1		; In case error
	CAIGE OPTL,8		; Header + one timestamp
	  JRST DOTSY		; Lose

	ILDB CPTR,OPTP		; Current pointer offset
	MOVEM OPTP,SAVPTR	; Save length for later update

	CAIG OPTL,(CPTR)	; Already full?
	  JRST DOTSF		; Yes
	SUBI CPTR,1+1		; Begins at 1 not 0 & ILDB not LDB

	ILDB T3,OPTP		; Get Overflow/Type
	ANDI T3,17		; Type field
; 4-byte options
	MOVX T4,4		; Assumed required length
	CAIGE OPTL,4(CPTR)	; Enough room for us?
	  JRST DOTSY		; No, parameter problem

	CAIN T3,0		; Is it Type 0?
	  JRST DOTS0		; Yes
; 8-byte options
	MOVX T4,8		; Required length
	CAIGE OPTL,8(CPTR)	; Enough room for us?
	  JRST DOTSY		; No, parameter problem

	CAIN T3,1		; Is it Type 1?
	  JRST DOTS1		; Yes
	CAIN T3,3		; Is it Type 3?
	  JRST DOTS3		; Yes

; Unknown type - may be protocol extension we don't know about,
; so just skip whole option
	JRST DOTSX

DOTS3:	; Type 3: Add time if we are next Id 

	ADJBP CPTR,T1		; Point before our slot

	MOVX T1,17		; Used to count bytes
	ILDB T2,CPTR	;***	; Get id byte
	LSH T2,↑D<36-8>	;***	; Left justify
	LSHC T1,↑D8	;***	; & pack
	JUMPGE T1,.-3	;***	; 4 bytes
	TXZ T1,<740000,,0>	; Mask to 32 bits
IFE MNET,<CAME T1,INETID>	; Is it us?
IFN MNET,<CALL LCLHST>		; Is it one of us?
	  JRST DOTSX		; No, skip option
	JRST DOTST		; Yes, Go add time


DOTS1:	; Type 1: Add our Id and current time since midnight to list

	ADJBP CPTR,T1		; Point before our slot

IFE MNET,<MOVE T2,INETID>	; Our Id
IFN MNET,<MOVE T2,DEFADR>	; Our default Id
	LSH T2,4		; Unused bits
	MOVX T1,17		; Unused bits in word
	LSHC T1,↑D8	;***	; Next byte
	IDPB T1,CPTR	;***	; Into header
	JUMPG T1,.-2	;***
	JRST DOTST


DOTS0:	; Type 0: Add current time since midnight to list

	ADJBP CPTR,T1		; Point before our slot

DOTST:	CALL INETUT		; Get current msec since midnight
	LSHC T1,↑D<-32>		; Left justify into T2
	MOVX T1,17		; Unused bits in word
	LSHC T1,↑D8	;***	; Next byte
	IDPB T1,CPTR	;***	; Into header
	JUMPG T1,.-2	;***

DOTSU:	LDB T1,SAVPTR		; Get old pointer
	ADD T1,T4		; Plus length we used
	DPB T1,SAVPTR		; Back into header
	JRST DOTSX		; All done without error

; Full

DOTSF:	ILDB T1,SAVPTR		; Get Ovfl/Type
	ADDI T1,20		; Bump Ovfl
	MOVX T2,3		; Parameter problem, Ovfl
	CAIL T1,400		; Field too large?
	  JRST DOTSY		; Yes, lose
	DPB T1,SAVPTR		; Update Ovfl

DOTSX:	SETZ T2,		; No error (offset for parameter problem)
DOTSY:				; Error exit with T2 set
	POP P,T1		; Restore arg
	RESTORE
	SETZ T3,
	RET

IFE MNET,<
; Send through an ARPANET interface

;T1/	Local Host number of Gateway in low 24 bits
;T3/	IMP Interface number (if MIMPDV)
;PKT/	Pointer to Internet packet
;
;	CALL SNDARP or SNDRCC
;Ret+1:	Always.  T1 non-0 if Pkt space will be release at lower level


SNDRCC::
SNDARP::LOCAL <IMPNUM>
	MOVEM T3,IMPNUM		; Save away the interface number
	SETZM LCLPKT+.NBLD0(PKT); Zero things not set explicitly
	SETZM LCLPKT+.NBLD1(PKT)
	SETZM LCLPKT+.NBLD2(PKT)
	STOR T1,IHADR,<+LCLPKT(PKT)>; Set host and IMP
	MOVEI T1,INTLNK		; Link number to use
	STOR T1,IHLNK,<+LCLPKT(PKT)>; Set Link

	MOVEI T1,STY%UC		; Uncontrolled flow
	JE PILDY,(PKT),SNDAR2	; Don't use Subtype 3 for Low-delay
	JN PIHRL,(PKT),SNDAR2	; or if any kind of reliability
	SKIPE ANT3EN		; needed.  Check if NCC enabled this
	  STOR T1,IHSTY,<+LCLPKT(PKT)> ; Set Message Subtype
SNDAR2:

IF1 <IFE HTY%HP&360,<PRINTX ? HTY%HP has moved>>
	MOVEI T1,<HTY%HP/20>	; High priority bit
	LOAD T2,PIPRC,(PKT)	; Get Precedence field
	CAIL T2,<1←<WID(PIPRC)-1>> ;Top Half?
	  STOR T1,IHHT2,<+LCLPKT(PKT)>	; Yes, Set IMP High priority

	MOVEI T2,ITY%LL		; Set new format indicator
	STOR T2,IHFTY,<+LCLPKT(PKT)> ; Set format type
	XMOVEI T2,LCLPKT(PKT)	; Pointer to IMPDV portion of pkt
;SNDAR5:
	LOAD T3,NBQUE,(PKT)	; Get the IMPPHY size
	ASH T3,2+3		; Convert into bits
	IDIVI T3,↑D1008		; Number of Packets
	STOR T3,IHHTY,<+LCLPKT(PKT)>

IFDEF IIN,<IFN IIN-IMPNUM,<PRINTX ?IMPNUM in SNDARP must equal IIN in  MIMPDV>>
	CALL INTQOB		; Get it queued for output
	 TDZA T1,T1		; Tell caller to dispose of the PKT
	  SETO T1,		; Lower level will worry about it.
	RESTORE
	RET

IFDEF BOSPRN,<	Packet Radio Interface code not yet tried ....

; Define fields in Packet Radio Net header:

DEFSTR(PRHL,0,7,4)		; Header Length in 16-bit bytes
DEFSTR(PRPL,0,15,8)		; Packet Length in 16-bit bytes
DEFSTR(PRSD,0,31,16)		; Source Device
  ; Overlays for the above:
  DEFSTR(PRSH,0,28,13)		; Source Host
  DEFSTR(PRSU,0,31,03)		; Source Use

DEFSTR(PRDD,1,15,16)		; Destination Device
  ; Overlays for the above:
  DEFSTR(PRDH,1,12,13)		; Destination Host
  DEFSTR(PRDU,1,15,03)		; Destination Use

DEFSTR(PRSN,1,28,3)		; Sequence number
DEFSTR(PRRC,1,13,13)		; Retransmission count
DEFSTR(PRTYP,2,2,3)		; Packet type
DEFSTR(PRACK,2,3,1)		; Acknowledgement
DEFSTR(PRDIR,2,4,1)		; Direction
DEFSTR(PRFCN,2,7,3)		; Function
DEFSTR(PRART,2,8,1)		; Alternate routed
DEFSTR(PRARQ,2,9,1)		; Acknowledgement required
DEFSTR(PRAIP,2,10,1)		; Alt. route in progress
DEFSTR(PRACT,2,11,1)		; Active Ack
DEFSTR(PRHP,2,15,4)		; Hop pointer

; 16 bits used by PR

DEFSTR(PRWD0,3,15,16)		; Route word 0

.PRHHL==7			; Where host-host leader goes

; SNDPRN	Send a packet into the packet radio net

;T1/	Local host number in PRN
;T3/	(Interface number)
;PKT/	Pointer to Internet packet
;
;	CALL SNDPRN
;Ret+1:	Always.  T1 non-0 if Pkt actually q'd for output.

SNDPRN::SETZM PRNHDR+0(PKT)	; Clear local leader area in pkt
	SETZM PRNHDR+1(PKT)
	SETZM PRNHDR+2(PKT)
	SETZM PRNHDR+3(PKT)
	SETZM PRNHDR+4(PKT)
	MOVEI T3,.PRHHL*2	; PRN header length in 16-bit bytes
	STOR T3,PRHL,+PRNDR(PKT); Store in packet
	LOAD T4,PIPL,(PKT)	; Internet packet length in bytes
	ADDI T4,1+<4*.PRHHL>	; Total number bytes in PRN packet
	ASH T4,-1		; Count in 16-bit bytes (note round up)
	STOR T4,PRPL,+PRNHDR(PKT); Store in PRN packet
	STOR T1,PRDH,+PRNHDR(PKT); Set destination in PRN
	MOVE T2,PRNHID		; Our ID on the PR Net
	STOR T2,PRSH,+PRNHDR(PKT); Set the source host
	AOS T3,PRSEQN		; Packet sequence number
	STOR T3,PRSN,+PRNHDR(PKT); Sequence number
	MOVEI T3,PRT%IN		; Info type packet
	STOR T3,PRTYP,+PRNHDR(PKT) ; Set into packet type field
	SETONE PRRW0,+PRNHDR(PKT); All one's in route word 0
	CALL PRNQOB		; Queue for output on PRN interface
	 TDZA T1,T1		; Indicate failure to caller
	 SETO T1,		; Indicate winnage to caller
	RET
> ; End IFDEF BOSPRN

; Send to gateway in machine connected to the RPI.  No local header
; is needed as this will be supplied by this other gateway.
; However space is left for an ARPANET leader for convenience.
;  This will be changed in the future.

;PKT/	Pointer to Internet packet
;T3/	(BCR number)
;
;	CALL SNDRPI
;Ret+1:	Always.  T1 non-0 if Pkt space will be released by INTNRB

SNDRPI:	XMOVEI T2,LCLPKT(PKT)	; Handle like ARPANET pkt due to INTRBF
	CALL RPIQOB		; Get it sent to the other gateway
	 TDZA T1,T1		; Convert into standard value
	 SETO T1,
	RET
>	; End of IFE MNET


	TNXEN